Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mdishe/mdimain.frm

Visual Basic Form | 1994-12-29 | 13.5 KB | 424 lines

VERSION 2.00
Begin MDIForm mdiMain
   Caption         =   "Main Applicaton Frame"
   ClientHeight    =   5970
   ClientLeft      =   2430
   ClientTop       =   2265
   ClientWidth     =   9015
   Height          =   6660
   HelpContextID   =   23
   Icon            =   0
   Left            =   2370
   LinkTopic       =   "Form1"
   Top             =   1635
   Width           =   9135
   Begin SSPanel ToolbarPanel
      Align           =   1  'Align Top
      Alignment       =   3  'Right Justify - TOP
      AutoSize        =   3  'AutoSize Child To Panel
      BackColor       =   &H00C0C0C0&
      BevelInner      =   2  'Raised
      BevelOuter      =   0  'None
      BorderWidth     =   0
      Font3D          =   0  'None
      ForeColor       =   &H00800000&
      Height          =   495
      HelpContextID   =   82
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9015
      Begin PictureClip PicClip1
         Cols            =   4
         Location        =   "1440,330,60,5040"
      End
      Begin CommonDialog CMDialog1
         Left            =   7260
         Top             =   0
      End
      Begin SSCommand Toolbar
         AutoSize        =   2  'Adjust Button Size To Picture
         BevelWidth      =   0
         Font3D          =   0  'None
         Height          =   360
         Index           =   2
         Left            =   840
         TabIndex        =   5
         Tag             =   "Print"
         Top             =   60
         Width           =   390
      End
      Begin SSCommand Toolbar
         AutoSize        =   2  'Adjust Button Size To Picture
         BevelWidth      =   0
         Font3D          =   0  'None
         Height          =   360
         Index           =   3
         Left            =   1230
         TabIndex        =   4
         Tag             =   "Save"
         Top             =   60
         Width           =   390
      End
      Begin SSCommand Toolbar
         AutoSize        =   2  'Adjust Button Size To Picture
         BevelWidth      =   0
         Font3D          =   0  'None
         Height          =   360
         Index           =   1
         Left            =   450
         TabIndex        =   3
         Tag             =   "Open an existing database"
         Top             =   60
         Width           =   390
      End
      Begin SSCommand Toolbar
         AutoSize        =   2  'Adjust Button Size To Picture
         BevelWidth      =   0
         Font3D          =   0  'None
         Height          =   360
         Index           =   0
         Left            =   60
         TabIndex        =   2
         Tag             =   "Create a new database"
         Top             =   60
         Width           =   390
      End
      Begin Label lblHelpTip
         AutoSize        =   -1  'True
         BackColor       =   &H0000FFFF&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblHelpTip"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   225
         Left            =   8040
         TabIndex        =   6
         Top             =   120
         Visible         =   0   'False
         Width           =   735
      End
      Begin Label Label1
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   195
         Left            =   6420
         TabIndex        =   1
         Top             =   120
         Width           =   495
      End
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      HelpContextID   =   4
      Begin Menu mnuFileNew
         Caption         =   "&New..."
         HelpContextID   =   5
      End
      Begin Menu mnuFileOpen
         Caption         =   "&Open..."
         HelpContextID   =   6
      End
      Begin Menu mnuFileSepBar1
         Caption         =   "-"
      End
      Begin Menu mnuFileCompact
         Caption         =   "&Compact Database..."
         HelpContextID   =   7
      End
      Begin Menu mnuFileRepair
         Caption         =   "&Repair Database..."
         HelpContextID   =   8
      End
      Begin Menu mnuFileSepBar2
         Caption         =   "-"
      End
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
         HelpContextID   =   9
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      HelpContextID   =   16
   End
   Begin Menu mnuWindow
      Caption         =   "&Window"
      HelpContextID   =   18
      WindowList      =   -1  'True
      Begin Menu mnuWindowCascade
         Caption         =   "&Cascade"
      End
      Begin Menu mnuWindowTileHoriz
         Caption         =   "Tile &Horizontal"
      End
      Begin Menu mnuWindowTileVert
         Caption         =   "Tile &Vertical"
      End
      Begin Menu mnuWindowSepBar1
         Caption         =   "-"
      End
      Begin Menu mnuWindowCloseAll
         Caption         =   "&Close All"
      End
      Begin Menu mnuWindowArrange
         Caption         =   "&Arrange Icons"
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
      HelpContextID   =   19
      Begin Menu mnuHelpContents
         Caption         =   "&Contents..."
      End
      Begin Menu mnuHelpSearch
         Caption         =   "&Search..."
      End
      Begin Menu mnuHelpSepBar1
         Caption         =   "-"
      End
      Begin Menu mnuHelpOnHelp
         Caption         =   "&How to use Help.."
      End
      Begin Menu mnuHelpSepBar2
         Caption         =   "-"
      End
      Begin Menu mnuHelpOrderInformation
         Caption         =   "&Ordering Information"
      End
      Begin Menu mnuHelpAbout
         Caption         =   "&About..."
      End
   End
' ********************************************************
'        MDI Standard Application Shell
' ********************************************************
' SUMMARY
' -------
' This file is part of an MDI application "skeleton"
' created by John Blessing of Leigh Business Enterprises Ltd.
' FEATURES
' --------
' Selection of application database.
' Compact/Repair of database.
' 'Helptips' on toolbar items.
' Support for Help files.
' MDI child forms tiling etc.
' Error trapping.
' 'Nag' screen support for shareware authors.
' Support for 3D dialogs (switched off in design mode
'   to prevent GPFs)
' USE
' ---
' You need VB Pro to use this shell, although it could be
' modified to run under the standard edition.
' You will need to set up some information in APP.BAS,
' particularly in SetAppInfo().  You will also need to add
' your own application specific code to this module.
' DISTRIBUTION
' ------------
' This program is "FreeWare" and may be used and distributed
' as you wish.
' It incorporates some ideas/code from other authors and these
' are acknowledged in the appropriate module.
' We hope that you will find it useful.  If you wish to discuss it
' then please e-mail us on Compuserve 100444,623.
' ADVERTISEMENT!
' --------------
' Are you looking for a helpdesk system? Or does your company
' want to track and monitor the progress of any work activity?
' We market a system which could be of interest to you.
' PROGRESS is available for download from the Business section
' of the Windows Shareware forum on Compuserve
' (filename PRGRSS10.ZIP).  It's a large program, so in the
' same section you will also find the help files and
' documentation as  PRGSSDOC.ZIP which is quicker to download
' and will give you a good idea of the functionality of PROGRESS.
' Dec 1994
Option Explicit
'======================================================================
'Form/Module:
'   mdiMain
'Procedure:
'   Load
'Modifications:
'   25/12/94   JBL     Build
'Description:
'   Set form size, set 3d dialogs, open the default database, set the title
'======================================================================
Sub MDIForm_Load ()
    Dim iRetVal, iCount As Integer
    Dim sRetVal As String
    'General Error Handler
    If Not bDesignMode() Then
        On Error GoTo Error_mdiMain_Load_Error
    End If
    Width = 640 * Screen.TwipsPerPixelX
    Height = 480 * Screen.TwipsPerPixelX
    'centre this form within the screen
    centre Me, Nothing
    Tag = "mdiMain"
    'load the toolbar icons
    PicClip1.Picture = LoadPicture(App.Path & "\toolbar.bmp")
    If tGApp.sHelpFile = "" Then
        'switch off the Help menu option
        mdiMain!mnuHelp.Visible = False
    End If
    'init to show no database opened
    tGApp.sDbaseName = ""
    'try and load the name of the database used last time
    GetDefaultDb
    If tGApp.sDbaseName <> "" Then
        'set the form title
        SetTitle mdiMain
    Else
        ClearTitle mdiMain
    End If
    'set up the toolbar
    For iCount = 0 To tGApp.iToolButtonCount - 1
        Toolbar(iCount).Outline = False
        Toolbar(iCount).Picture = PicClip1.GraphicCell(iCount)
    Next
    'if you use 3d dialogs in design mode and break the program
    'flow for debugging, then quite often VB will cause a
    'gpf.
    If Not bDesignMode() Then
        'try and use 3d dialogs
        Ctl3D_Start
    End If
    Exit Sub
Error_mdiMain_Load_Error:
    'call the generic error handler
    GenErrorHandler "mdiMain.frm - Load", Err, Error$
    Resume Exit_mdiMain_Load_Error
Exit_mdiMain_Load_Error:
End Sub
'======================================================================
'Form/Module:
'   mdiMain
'Procedure:
'   Unload
'Modifications:
'   25/12/94   JBL     Build
'Description:
'   Finish with help and switch off 3d dialogs
'======================================================================
Sub MDIForm_Unload (Cancel As Integer)
    Dim iRetVal As Integer
    'General Error Handler
    If Not bDesignMode() Then
        On Error GoTo Error_mdiMain_Unload_Error
    End If
    'finished with help
    iRetVal = WinHelp(Forms(0).hWnd, tGApp.sHelpFile, HELP_QUIT, CLng(0))
    'Unregister the Ctl3d functions
    Ctl3D_End
Exit_mdiMain_Unload_Error:
    End
Error_mdiMain_Unload_Error:
    'call the generic error handler
    GenErrorHandler "mdiMain.frm - Unload", Err, Error$
    Resume Exit_mdiMain_Unload_Error
End Sub
Sub mnuFileCompact_Click ()
    CompactDbase cmdialog1
End Sub
Sub mnuFileExit_Click ()
    Unload Me
End Sub
Sub mnuFileNew_Click ()
    NewDbase
End Sub
Sub mnuFileOpen_Click ()

    OpenDbase
End Sub
Sub mnuFileRepair_Click ()
    RepairDbase cmdialog1
End Sub
Sub mnuHelpAbout_Click ()
    fAbout.Show 1
End Sub
Sub mnuHelpContents_Click ()
    Dim iRetVal As Integer
    iRetVal = WinHelp(Forms(0).hWnd, tGApp.sHelpFile, HELP_INDEX, CLng(0))
End Sub
Sub mnuHelpOnHelp_Click ()
    Dim iRetVal As Integer
    iRetVal = WinHelp(Forms(0).hWnd, tGApp.sHelpFile, HELP_HELPONHELP, CLng(0))
End Sub
'======================================================================
'Form/Module:
'   mdiMain.frm
'Procedure:
'   mnuHelpOrderInformation
'Parameters:
'   None
'Returns:
'   None
'Modifications:
'   26/12/94   JBL     Build
'Description:
'   Uses write to show a file with order information
'======================================================================
Sub mnuHelpOrderInformation_Click ()
    Dim i As Integer
    Dim sCmd As String
    'General Error Handler
    If Not bDesignMode() Then
        On Error GoTo Error_OrderInfo
    End If
    If tGApp.sOrderInfoFile <> "" Then
        sCmd = "write.exe " & tGApp.sOrderInfoFile
        i = Shell(sCmd, 1)
    End If
    Exit Sub
Error_OrderInfo:
    'call the generic error handler
    GenErrorHandler "MAIN.BAS - OrderInfo()", Err, Error$
    Resume Exit_OrderInfo
Exit_OrderInfo:
End Sub
Sub mnuHelpSearch_Click ()
    Dim iRetVal As Integer
    iRetVal = WinHelp(Forms(0).hWnd, tGApp.sHelpFile, HELP_PARTIALKEY, "")
End Sub
Sub mnuWindowArrange_Click ()
    Arrange ARRANGE_ICONS
End Sub
Sub mnuWindowCascade_Click ()
    Arrange CASCADE
End Sub
Sub mnuWindowCloseAll_Click ()
    CloseAllChildren
End Sub
Sub mnuWindowTileHoriz_Click ()
    Arrange TILE_HORIZONTAL
End Sub
Sub mnuWindowTileVert_Click ()
    Arrange TILE_VERTICAL
End Sub
Sub Toolbar_Click (Index As Integer)
    'clear the helptip
    HelpTip Index, lblHelpTip, 0, 0
    'action this button
    ToolbarAction Index
End Sub
Sub Toolbar_MouseMove (Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    HelpTip Index, lblHelpTip, x, y
End Sub
Sub ToolbarPanel_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    lblHelpTip.Visible = False
End Sub